MacHack 1994/MacHack 1994.toast/MacHack™94/Talks & Papers/Timothy Knox/Help/Help Files/Miscellaneous/Examples

Text File | 1994-06-24 | 11KB | 350 lines

{••••••••••••••••••• VARIOUS EXAMPLES FOR HELP Rel 1.4 ••••••••••••••••••••••}

{Iterative Fibonnacci U0=0 U1=1, with a local function}
{•••••••••••••••••••••••••••••••••••••••••••••••••••••}

(define (fib m)
  (letrec [((fi n n1 n2)
            (cond (zero? n) (+ n1 n2)
                  (fi (1- n) n2 (+ n1 n2))))]
          (fi (- m 2) 1 1)))

(fib 100)
{ = 573147844013817084101 }

{Recursive Fibonnacci}
{••••••••••••••••••••}

(define (f n)
  (cond (<? n 2) 1
  (+ (f (1- n)) (f (- n 2)))))

(f 20)
{ = 10946 }

{Surface Remove}
{••••••••••••••}

(define (remove a l)
     (cond (null? l) ()
           (eq? a (0 l)) (remove a (-1 l))
           (cons (0 l) (remove a (-1 l)))))

(remove 'a '(b c d a d e d a b))
{ = (b c d d e d b) }

{Count how many ways to distribute s using coin types list c}
{••••••••••••••••• from Abelsson and Sussman •••••••••••••••}

(define (cat s c)
       (cond (null? c) 0
             (zero? s) 1
             (<? s (0 c)) (cat s (-1 c))
             (+ (cat s (-1 c))
                      (cat (- s (0 c)) c))))

(cat 27 '(1 2 5 10))
{ = 76 }

{Physical Reverse}
{••••••••••••••••}

(define (nreverse ll)
  (letrec [((nrevaux l p)
            (cond (null? (-1 l)) (cdr=! l p)
                  (nrevaux (-1 l)(cdr=! l p))))]
          (nrevaux ll '())))

(nreverse '(a b c d))
{ = (d c b a) }

{Compose functions}
{•••••••••••••••••}

(define (o f g)
        (lambda x (f (apply g x))))

(define 2+ (o 1+ 1+))

(2+ 2)
{ = 4 }

{Various list or stream related operations}
{•••••••••••••••••••••••••••••••••••••••••}

{••• Every element of l satisfies p •••}

(define (every p l)
      (cond (null? l) ()
            (null? (-1 l)) (p (0 l))
            (p (0 l))(every p (-1 l))))

(every keyword? '(lambda cond =! let letrec))
{ = letrec }

{••• Some element of l satisfies p •••}

(define (some p l)
      (cond (null? l) ƒ
            (p (0 l)) (0 l)
            (some p (-1 l))))

(some number? '(a d %1101 "azertyiop" 12 lambda))
{ = 12 }

{••• All the integers •••}
{••••••••••••••••••••••••}

(define n (… 0))

n
{ = (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 …) }

{••• All even integers : sum each integer with itself •••}

(define even (map (∞ +) n n))

even
{ = (0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30 32 34 36 38 40 42 44 46 48 50 52 54 56 58 60 62 64 66 68 70 72 74 76 78 80 82 84 86 88 90 92 94 96 98 100 102 104 106 108 110 112 114 116 118 120 122 124 126 128 130 132 134 136 138 140 142 144 146 148 150 152 154 156 158 160 162 164 166 168 170 172 174 176 178 180 182 184 186 188 190 192 194 196 198 …) }

{••• All odd integers : get rid of the even ones •••}

(define odd (diff n even))

odd
{ = (1 3 5 7 9 11 13 15 17 19 21 23 25 27 29 31 33 35 37 39 41 43 45 47 49 51 53 55 57 59 61 63 65 67 69 71 73 75 77 79 81 83 85 87 89 91 93 95 97 99 101 103 105 107 109 111 113 115 117 119 121 123 125 127 129 131 133 135 137 139 141 143 145 147 149 151 153 155 157 159 161 163 165 167 169 171 173 175 177 179 181 183 185 187 189 191 193 195 197 199 …) }

{The list of all Fibonnacci numbers: the nth}
{ number is the sum of the two previous ones}
{•••••••••••••••••••••••••••••••••••••••••••}

(define fibn1
  (cons 1 (cons 1 (map (∞ +) fibn1 (-1 fibn1)))))

fibn1
{ = (1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 17711 28657 46368 75025 121393 196418 317811 514229 832040 1346269 2178309 3524578 5702887 9227465 14930352 24157817 39088169 63245986 102334155 165580141 267914296 433494437 701408733 1134903170 1836311903 2971215073 4807526976 7778742049 12586269025 20365011074 32951280099 53316291173 86267571272 139583862445 225851433717 365435296162 591286729879 956722026041 1548008755920 2504730781961 4052739537881 6557470319842 10610209857723 17167680177565 27777890035288 44945570212853 72723460248141 117669030460994 190392490709135 308061521170129 498454011879264 806515533049393 1304969544928657 2111485077978050 3416454622906707 5527939700884757 8944394323791464 14472334024676221 23416728348467685 37889062373143906 61305790721611591 99194853094755497 160500643816367088 259695496911122585 420196140727489673 679891637638612258 1100087778366101931 1779979416004714189 2880067194370816120 4660046610375530309 7540113804746346429 12200160415121876738 19740274219868223167 31940434634990099905 51680708854858323072 83621143489848422977 135301852344706746049 218922995834555169026 354224848179261915075 …) }


{A strange sequence: A fixpoint for shuffling with integers}
{••••••••••••••••••••••••••••••••••••••••••••••••••••••••••}

{••• A shuffling function FOR STREAMS (no (null? l1) test) •••}

(define (entrelace l1 l2)
      (cons (0 l1) (cons (0 l2) (entrelace (-1 l1) (-1 l2)))))

{••• The sequence itself •••}

(define Strange (entrelace (… 0) Strange))

Strange
{ = (0 0 1 0 2 1 3 0 4 2 5 1 6 3 7 0 8 4 9 2 10 5 11 1 12 6 13 3 14 7 15 0 16 8 17 4 18 9 19 2 20 10 21 5 22 11 23 1 24 12 25 6 26 13 27 3 28 14 29 7 30 15 31 0 32 16 33 8 34 17 35 4 36 18 37 9 38 19 39 2 40 20 41 10 42 21 43 5 44 22 45 11 46 23 47 1 48 24 49 12 …) }

{Input Stream}
{••••••••••••}

(define (in)(cons (read)(in)))

(define input (in))

{Factorial using Continuation Passing Style}
{••••••••••••••••••••••••••••••••••••••••••}

(define (fact x k)
     (cond (zero? x)(k 1)
     (fact (- x 1)(lambda(n)(k (* x n))))))

(fact 5 I)
{ = 120 }

{Factorial stream}
{••••••••••••••••}

(define factl (cons 1 (map (∞ *) (… 1) factl)))

factl

{Erathostène filter}
{••••••••••••••••••}

(define (erat l)
  (cons (0 l)
        (erat
           (suchas (lambda(x) (not (zero?(modulo x (0 l))))) (-1 l)))))

(define primes (erat (… 2)))

primes
{ = (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 …) }

{Another reverse via a fix point def.}
{••••••••••••••••••••••••••••••••••••}

(define arg '(a b c d))

(define rev (cons () (map (∞ cons) arg rev)))

((length arg) rev)
{ = (d c b a) }

{Hanoi}
{•••••}

(define (hanoi n dep ar etap)
     (cond (=? n 1)(deplacer dep ar)
           (begin (hanoi (- n 1) dep etap ar)
                  (deplacer dep ar)
                  (hanoi (- n 1) etap ar dep))))

(define (deplacer x y)
     (prin "From ")(prin x) (prin " to ") (print y))

(hanoi 3 'a 'b 'c)
From a to b
From a to c
From b to c
From a to b
From c to a
From c to b
From a to b
{ = ? }

{The paradoxical combinator}
{••••••••••••••••••••••••••}

;by Church Y0
(define (Y0 g)
  ((lambda(x) (G (x x)))(lambda(x)(G (x x)))))

{The fixed point for fixed point combinator}
{••••••••••••••••••••••••••••••••••••••••••}

(define (G y)
  (lambda(f) (f (y f))))

;by Turing Y1=Y0 G
(define Y1
  ((lambda(a)
    (lambda(b) (b ((a a) b)))) (lambda(a)
                                 (lambda(b) (b ((a a) b))))))
;Another simple one by Klop
(define £
 (lambda(a)
  (lambda(b)
   (lambda(c)
    (lambda(d)
     (lambda(e)
      (lambda(f)
       (lambda(g)
        (lambda(h)
         (lambda(i)
          (lambda(j)
           (lambda(k)
            (lambda(l)
             (lambda(m)
              (lambda(n)
               (lambda(o)
                (lambda(p)
                 (lambda(q)
                  (lambda(s)
                   (lambda(t)
                    (lambda(u)
                     (lambda(v)
                      (lambda(w)
                       (lambda(x)
                        (lambda(y)
                         (lambda(z)
                          (lambda(r)
(r((((((((((((((((((((((((((t h)i)s)i)s)a)f)i)x)e)d)p)o)i)n)t)c)o)m)b)i)n)a)t)o)r)))))))))))))))))))))))))))))

(define $ (((((((((((((((((((((((((£ £)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£))

;Another one "en VF"
(define £
 (lambda(a)
  (lambda(b)
   (lambda(c)
    (lambda(e)
     (lambda(f)
      (lambda(g)
       (lambda(h)
        (lambda(i)
         (lambda(j)
          (lambda(k)
           (lambda(l)
            (lambda(m)
             (lambda(n)
              (lambda(o)
               (lambda(p)
                (lambda(q)
                 (lambda(r)
                  (lambda(s)
                   (lambda(t)
                    (lambda(u)
                     (lambda(v)
                      (lambda(w)
                       (lambda(x)
                        (lambda(y)
                         (lambda(z)
                          (lambda(d)
(d((((((((((((((((((((((((((H e)l)p) E)s)t) T)e)r)r)i)b)l)e)m)e)n)t) F)l)e)m)m)a)r)d)))))))))))))))))))))))))))))

(define $ (((((((((((((((((((((((((£ £)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£)£))

;Factorial associated functionnal, then factorial itself
(define (FF f)
  (lambda(x)
    (cond (zero? x) 1
          (* (f (1- x)) x))))

(define fact2 (Y1 FF))

(fact2 5)
{ = 120 }

{Use primes list l to decompose number n}
{•••••••••••••••••••••••••••••••••••••••}

(define (dec n l)
  (cond (=? n 1) ()
        (zero? (modulo n (0 l))) (cons (0 l) (dec (/ n (0 l)) l))
        (<? n (* (0 l)(0 l))) (list n)
        (dec n (-1 l))))

(dec 123469 primes)
{ = (37 47 71) }

{A Quick Sort}
{••••••••••••}

(define (sortby f l)
  (letrec [((splitby x part ll r)
            (cond (null? x)(cons ll r)
                  (<? (f (0 x))(f part))
                    (splitby f (-1 x) part (cons (0 x) ll) r)
                  (splitby (-1 x) part ll (cons (0 x) r))))

           ((sortit lr)(append (sortby f (0 lr))
                               (append (list (0 l)) (sortby f (-1 lr)))))]
          (cond (null? l) ()
                (sortit (splitby (-1 l) (0 l) () ())))))

(sortby I '(0 2 4 6 5 3 1))
{ = (0 1 2 3 4 5 6) }

{••• A simple backward chaining horn clauses propositionnal ••••}
{• prover: b is the knowledge base, a is the prop var to prove •}
{• a horn clause a1…an -> b is coded by the list (b a1 … an)   •}
{•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••}

(define (p a b)
 (some (lambda(r)
        (if (eq? (0 r) a) (every (lambda(f) (p f b)) (-1 r))
            ƒ))
      b))

(p 'a '((a b c) (b e)(b)(c e)))
{ = ƒ }
(p 'a '((a b c) (b e)(e)(c e)))
{ = (a b c) }